home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / NRCOBOL1g / Extra / CED.support / Cobol_English.Rexx next >
Encoding:
OS/2 REXX Batch file  |  1998-10-13  |  8.5 KB  |  313 lines
  1. /*
  2.    Macro Arexx to control NrCobol from CygnusEd (4.2)
  3.    © 1998 - By Bertuccio Saul
  4. */
  5.  
  6. Options Results
  7.  
  8. Call AddLib('rexxsupport.library',0,-30,0)
  9. Call AddLib('rexxtricks.library',0,-30,0)
  10.  
  11. Operazione       = UPPER(Arg(1))
  12.  
  13. Ret            = "0A"x
  14. Port           = "COBOL"
  15.  
  16. Est.Sorgente   = "COB"
  17. Est.Exe        = "INT"
  18. Est.Lista      = "LST"
  19. Est.Change     = "CNG"
  20. Est.LastComp   = "RES"
  21. Est.LastErr    = "ERR"
  22.  
  23. Msg.NoPort     = "Can't open the Port" Port
  24. Msg.ErrNoSave  = "Save the file first"
  25. Msg.ErrEst     = "The file must have" Est.Sorgente "extension"
  26. Msg.ErrNoLista = "The list file don't exists"
  27. Msg.ErrLista   = "The flag for producing" || RET || "listing must be set"
  28. Msg.Comp       = "Compiling the file"
  29. Msg.Wait       = "-- PLASE WAIT --"
  30. Msg.NoErr      = "No Error"
  31. Msg.NoNextErr  = "No other error"
  32. Msg.Exe        = "Running the file"
  33. Msg.Config     = "Preferences: (S) Save - (U) Use - (C) Cancel"
  34. Msg.ErrSaveCfg = "Can't save the preferences"
  35. Msg.Save       = "AutoSave the source file?"
  36. Msg.Lista      = "Making a listing file?"
  37. Msg.Debug      = "Making a debug linsting file?"
  38.  
  39. NRCOBOL        = 'Lavoro:Programmazione/Cobol/NrCobol' /* Path of the Compiler */
  40. RUNCOB         = 'Lavoro:Programmazione/Cobol/RunCob'  /* Path of the executer :) */
  41.  
  42. Modifiche      = 0
  43.  
  44. CED.RESTNAME       = 21
  45. CED.FILENAME       = 19
  46. CED.NUMCHANGES     = 18
  47. CED.CURSORLINE     = 47
  48.  
  49. /* DEFAULT SETUP */
  50.  
  51. Cfg.Nome          = "Cobol.prefs"    /* Name of preference file */
  52. Cfg.Salvataggio   = 0
  53. Cfg.Lista         = 1
  54. Cfg.Debug         = 1
  55.  
  56.  
  57. /* MAIN */
  58.  
  59. Call Carica_Configurazione
  60.  
  61. If Port ~= Left(ADDRESS(),Length(Port)) Then
  62.    Say Msg.NoPort
  63.  
  64. Nome.Sorgente = Ottieni_Nome_File(CED.RESTNAME)
  65. If Nome.Sorgente = '' Then
  66.    Do
  67.       'Save As'
  68.       If RESULT = 0 Then
  69.          Do
  70.             'Okay1' Msg.ErrNoSave
  71.             CALL Uscita(0)
  72.          End
  73.   End
  74. Else
  75.    Do
  76.       'Status' CED.NUMCHANGES
  77.       Modifiche = Result
  78.       If Cfg.Salvataggio = 1 & Modifiche ~= 0 Then
  79.          'Save'
  80.    End
  81.  
  82. Nome.Sorgente = Ottieni_Nome_File(CED.FILENAME)
  83. if UPPER(SuffixPart(Nome.Sorgente)) ~= Est.Sorgente Then
  84.    Do
  85.       'Okay1' Msg.ErrEst
  86.       Call Uscita(0)
  87.    End
  88.  
  89. Nome.File     = Strip(FilePart(MakeSuffix(Nome.Sorgente,'',R)),'T','.')
  90. Nome.Change   = Nome.File || Est.Change
  91. Nome.LastComp = Nome.File || Est.LastComp
  92. Nome.LastErr  = Nome.File || Est.LastErr
  93. Nome.Exe      = MakeSuffix(Nome.Sorgente, Est.Exe,'R')
  94. Nome.Lista    = MakeSuffix(Nome.Sorgente, Est.Lista,'R')
  95.  
  96. SELECT
  97.    When Operazione   = 'COMPILA'   Then
  98.       CALL Compila
  99.    When Operazione   = 'ESEGUI'    Then
  100.       CALL Esegui
  101.    When Operazione   = 'CONFIGURA' Then
  102.       CALL Configura
  103.    When Operazione   = 'ERRORI'    Then
  104.       CALL Errori
  105.    OtherWise
  106.       NOP
  107. End
  108.  
  109. CALL Uscita(0)
  110.  
  111. /* END MAIN */
  112.  
  113. Compila: Procedure Expose NRCOBOL RUNCOBOL Nome. Msg. Cfg. Ret Modifiche
  114.    'DM' Msg.Comp Nome.Sorgente Msg.Wait
  115.    If Cfg.Lista = 1 Then Opzioni = '-L'
  116.    If Cfg.Debug = 1 Then Opzioni = Opzioni '-D'
  117.    Opzioni = Opzioni '>' 'T:' || Nome.File
  118.    CALL Compilazione(Nome.Sorgente, Opzioni)
  119.    Risultato = VisualizzaRisultati('T:' || Nome.File)
  120.    CALL SetEnv(Nome.LastComp, Risultato)
  121.    CALL SetEnv(Nome.LastErr, 4)
  122.    'DM'
  123. Return Risultato
  124.  
  125. Esegui: Procedure Expose NRCOBOL RUNCOBOL Nome. Msg. Cfg. Ret Modifiche
  126.    Run = GetEnv(Nome.LastComp)
  127.    If Run = '' Then
  128.       Run = 1
  129.    ModifichePrecedenti    = GetEnv(Nome.Change)
  130.    If ModifichePrecedenti = '' Then
  131.       ModifichePrecedenti = Modifiche
  132.    CALL SetEnv(Nome.Change, Modifiche)
  133.    If ~Newer(Nome.Sorgente, Nome.Exe) | Modifiche ~= ModifichePrecedenti | Run = 0 Then
  134.       Run = Compila()
  135.    If Run = 1 Then
  136.        Do
  137.           'DM' Msg.Exe Nome.Exe
  138.           CALL Esecuzione(Nome.Exe)
  139.        End
  140.   'Dm'
  141. Return Run
  142.  
  143. Configura: Procedure Expose Ret Cfg. Msg.
  144.     'Okay2' Msg.Save;    Salvataggio = Result
  145.     'Okay2' Msg.Lista;   Lista       = Result
  146.     'Okay2' Msg.Debug;   Debug       = Result
  147.     Impostazioni = Salvataggio Lista Debug
  148.     Continua = 1
  149.     Do While Continua = 1
  150.        'DM' Msg.Config
  151.        Tasto = -1
  152.        Do Until Tasto ~= -1
  153.           'LASTKEY'
  154.           Tasto = RESULT
  155.        End
  156.        Key = Word( Tasto, 1)
  157.        SELECT
  158.           When Key = 33 Then CALL Salva
  159.           When Key = 22 Then CALL Usa
  160.           When Key = 51 Then Continua = 0
  161.           OtherWise NOP
  162.        End
  163.     End
  164.     'DM'
  165. Return
  166.  
  167. Errori: Procedure Expose Nome. Msg. Cfg. CED. RET
  168.    Res      = GetEnv(Nome.LastComp)
  169.    LastLine = GetEnv(Nome.LastErr)
  170.    If LastLine  = '' Then LastLine = 4
  171.    Select
  172.        When Cfg.Lista = 0       Then Messaggio = Msg.ErrLista
  173.        When Res       = 1       Then Messaggio = Msg.NoErr
  174.        When ~Exists(Nome.Lista) Then Messaggio = Msg.ErrNoLista
  175.        OtherWise
  176.           Fine = 0
  177.           Do Until Fine = 1
  178.              Line = SearchPattern(Nome.Lista, 'LINE', LastLine, 'L', 'N')
  179.              If Line ~= -1 Then
  180.                 Do
  181.                    Parse Var Result Dummy 'Line' Numero Errore
  182.                    If DataType(Numero,'N') & Dummy ='' Then
  183.                       Do
  184.                          Messaggio = 'Error at Line:' Numero || Ret || Errore
  185.                          LL Numero
  186.                          'Dm' Errore
  187.                          SetEnv(Nome.LastErr, Line + 1)
  188.                          Fine = 1
  189.                       End
  190.                    Else
  191.                       LastLine = Line + 1
  192.                 End
  193.              Else
  194.                 Do
  195.                    Messaggio = Msg.NoNextErr
  196.                    Fine = 1
  197.                 End
  198.           End
  199.    End
  200.    'Okay1' Messaggio
  201. Return
  202.  
  203. Salva:
  204.    If ~Open(Handle,'ENVARC:' || Cfg.Nome,'W') Then
  205.        'Okay1' Msg.ErrSaveCfg
  206.     Else
  207.        Writeln(Handle, Impostazioni)
  208. Usa:
  209.    CALL SetEnv(Cfg.Nome, Impostazioni)
  210.    Continua = 0
  211. Return
  212.  
  213. Compilazione: Procedure Expose NRCOBOL
  214.    ADDRESS COMMAND NRCOBOL '"' || Arg(1) || '"' Arg(2)
  215. Return
  216.  
  217. Esecuzione: Procedure Expose RUNCOB
  218.    ADDRESS COMMAND RUNCOB '"' || Arg(1) || '"'
  219. Return
  220.  
  221. Ottieni_Nome_File: Procedure
  222.    'Status' ARG(1)
  223. Return RESULT
  224.  
  225. Newer: Procedure
  226.    NomeFile1 = ARG(1)
  227.    NomeFile2 = ARG(2)
  228.    Parse Value Statef(NomeFile1) With . . . . GiorniFile1 Minuti CinquSec .
  229.    SecondiFile1 = ( Minuti * 60 ) + ( CinquSec / 50 )
  230.    If Exists(NomeFile2) Then
  231.       Do
  232.          Parse Value Statef(NomeFile2) With . . . . GiorniFile2 Minuti CinquSec .
  233.          SecondiFile2 = ( Minuti * 60 ) + ( CinquSec / 50 )
  234.          If GiorniFile1 <= GiorniFile2 & SecondiFile1 < SecondiFile2 Then
  235.             Return 1
  236.       End
  237. Return 0
  238.  
  239. Carica_Configurazione: Procedure Expose Cfg.
  240.    Configurazione = GetEnv(Cfg.Nome)
  241.    If Configurazione ~= '' Then
  242.        Parse Var Configurazione Cfg.Salvataggio Cfg.Lista Cfg.Debug
  243. Return
  244.  
  245. VisualizzaRisultati: PROCEDURE Expose RET
  246.    Ok            = 1
  247.    TempFile      = ARG(1)
  248.    Intestazione  =  'NRCOBOL V1.0d - cHArRiOTt97-98(c)'
  249.    Pattern.0     = 5
  250.    Pattern.1     = 'IDENTIFICATION DIVISION'
  251.    Pattern.2     = 'ENVIRONMENT DIVISION'
  252.    Pattern.3     = 'DATA DIVISION'
  253.    Pattern.4     = 'PROCEDURE DIVISION'
  254.    Pattern.5     = 'Ending at'
  255.    Adj.1         = 27
  256.    Adj.2         = 28
  257.    Adj.3         = 34
  258.    Adj.4         = 29
  259.    Adj.5         = 0
  260.    LCurr         = 1
  261.    Do Pat = 1 To Pattern.0
  262.        LPrec = SearchPattern(TempFile, Pattern.Pat, LCurr, 'L', 'N')
  263.        IF LPrec = -1  Then
  264.           Do
  265.              LCurr = -1
  266.              LPrec = 0
  267.           End
  268.        Else If Pat < Pattern.0 Then
  269.           LCurr = SearchPattern(TempFile, Pattern.Pat, LPrec + 1, 'L', 'N')
  270.        Else
  271.           LCurr = LPrec
  272.        If LCurr ~= -1 Then
  273.           Do
  274.              PARSE Var Result (Pattern.Pat) Risultato.Pat
  275.              Risultato.Pat = Traduci(Strip(Risultato.Pat,'B','. '))
  276.           End
  277.        Else
  278.           Do
  279.              LCurr = LPrec + 1
  280.              Risultato.Pat = 'omessa'
  281.              Ok = 0
  282.           End
  283.    End
  284.    Messaggio = Intestazione
  285.    Do Pat = 1 For Pattern.0
  286.       Messaggio = Messaggio || Copies(Ret,2) || Left(Pattern.Pat,Adj.pat,'.') || Risultato.Pat
  287.    End
  288.    'Okay1' Messaggio
  289. Return Ok
  290.  
  291. Traduci: Procedure Expose OK
  292.    Select
  293.       When Arg(1) = 'passed'    Then Return Arg(1)
  294.       When Arg(1) = 'failed'    Then Return Arg(1)
  295.       When Arg(1) = 'not found' Then Return Arg(1)
  296.       Otherwise
  297.             Parse Upper Arg 'LINE' Num ',' 'THERE' . err 'ERRORS'
  298.             Ret = 'Ending at line' Num
  299.             If Upper(Err) = 'NO' Then
  300.                Return Ret '- NO ERROR -'
  301.             Else
  302.                Do
  303.                   Ok = 0
  304.                   Return Ret ' - WITH' Err 'ERROR -'
  305.                End
  306.    End
  307.  
  308. Uscita: Procedure
  309.    Call RemLib('rexxsupport.library')
  310.    Call RemLib('rexxtricks.library')
  311.    'CEDTOFRONT'
  312. Exit ARG(1)
  313.